Dashboard

Total Cases

>>>>>>> 59abd0a87075ca6519eca431514f4a16c79d87fb

New cases last 24h

Column

Key figures

<<<<<<< HEAD
=======
>>>>>>> 59abd0a87075ca6519eca431514f4a16c79d87fb

Column

Cases per municipality and district

<<<<<<< HEAD
=======
>>>>>>> 59abd0a87075ca6519eca431514f4a16c79d87fb
---
title: "Covid-19 Cases: Norway"
output: 
  flexdashboard::flex_dashboard:
    social: menu
    source_code: embed
    theme: flatly
    navbar:
      - { icon: "fa-sign-out-alt", href: "https://www.covid19data.no", align: left, title: "Back" }
    includes:
      in_header: ../../analytics.html
    
---

```{js}
$('.navbar-inverse').removeClass('navbar-inverse').addClass('navbar-default');
```

```{r}
library(tidyverse)
library(here)
library(glue)
library(sf)
library(lubridate)
library(sparkline)
library(DT)
library(leaflet)
library(crosstalk)
library(summarywidget)

inf_raw     <- read_csv(here::here("data", "01_infected", "msis", "municipality_and_district.csv"))
inf_map_raw <- st_read(here::here("data", "00_lookup_tables_and_maps", "02_maps", "msis.geojson"), quiet = TRUE)

# Replace lines above with this if running externally
# inf_raw     <- read_csv("https://raw.githubusercontent.com/thohan88/covid19-nor-data/master/data/01_infected/msis/municipality_and_district.csv")
# inf_map_raw <- st_read("https://raw.githubusercontent.com/thohan88/covid19-nor-data/master/data/00_lookup_tables_and_maps/02_maps/msis.geojson", quiet = TRUE)

# MSIS-data is at bydel-level for Oslo and Bergen. Add Oslo and Bergen at municipality-level as well
inf_district <- inf_raw %>% 
  filter(bydel_name != "") %>% 
  mutate(region = paste0(bydel_name, " (", kommune_name, ")")) %>% 
  select(date, region_no = kommune_bydel_no, region, county = fylke_name, cases, population)

inf_municipality <- inf_raw %>% 
  group_by(date, region_no = kommune_no, region = kommune_name, county = fylke_name) %>% 
  summarise_at(vars(cases, population), sum, na.rm = TRUE) %>% 
  ungroup()

# Breaks for categorizing cases per population
breaks <- c(-1, 0, 0.5, 1, 2, 5, 10, 1000)
labels <- c("0", "0 - 0.5", "0.5 - 1", "1 - 2", "2 - 5", "5 - 10", ">10")

# Create sparklines for cases and growth and other statistics
inf <- inf_municipality %>% 
  bind_rows(inf_district) %>% 
  arrange(date, region) %>% 
  group_by(region_no, region) %>% 
  mutate(new_cases = cases - lag(cases, 1)) %>% 
  ungroup() %>% 
  arrange(region, date) %>% 
  group_by(region_no, region, county) %>% 
  nest() %>% 
  ungroup() %>% 
  mutate(cases_current = map(data, ~.x %>% select(cases, population) %>% slice(n())),
         cases_lag_1d  = map_dbl(data, ~.x %>%  slice(n()-1) %>% pull(cases)),
         cases_lag_5d  = map_dbl(data, ~.x %>%  slice(n()-5) %>% pull(cases)),
         cases_lag_10d = map_dbl(data, ~.x %>%  slice(n()-10) %>% pull(cases))) %>% 
  unnest(cases_current) %>% 
  mutate(cases_inc_1d        = cases - cases_lag_1d,
         cases_per_pop       = round(cases/population*1000, 1),
         cases_log           = log10(cases),
         cases_per_pop_grp   = cut(cases_per_pop, include.lowest = TRUE, breaks = breaks, labels = labels),
         doubling_time_1d    = round((1*log(2))/log(cases/cases_lag_1d), 1),
         doubling_time_5d    = round((5*log(2))/log(cases/cases_lag_5d), 1),
         doubling_time_10d   = round((10*log(2))/log(cases/cases_lag_10d), 1),
         sparkline_cases     = map(data, ~.x %>% slice((n()-10):n()) %>% pull(cases) %>% spk_chr(type="line")),
         sparkline_new_cases = map(data, ~.x %>% slice((n()-10):n()) %>% pull(new_cases) %>% spk_chr(type="bar"))) %>% 
  mutate_at(vars(matches("doubling|log"), cases_per_pop), ~ifelse(is.na(.x) | is.infinite(.x) | is.nan(.x) | .x <= 0, NA, .x)) %>% 
  select(-data)

# Setup a map and add pop-info 
inf_map <- inf_map_raw %>%
  select(region_no = kommune_bydel_no) %>%
  left_join(inf, by = "region_no") %>% 
  mutate(cases_per_pop_grp = cut(cases_per_pop, include.lowest = TRUE, breaks = breaks, labels = labels)) %>% 
  mutate(cases_per_pop_grp = cut(cases_per_pop, include.lowest = TRUE, breaks = breaks, labels = labels)) %>% 
  mutate(popup_table = map2(cases, cases_per_pop, ~glue('
Cases: {coalesce(.x, 0)}
Cases per population: {coalesce(.y, 0)}
'))) %>% mutate(popup_table = map2(region, popup_table, ~glue("

{.x}

{.y}"))) %>% select(region, popup_table, cases, cases_log, cases_per_pop, cases_per_pop_grp) # Setup tables inf_tbl <- inf %>% select(region, cases, cases_inc_1d, cases_per_pop, sparkline_cases, sparkline_new_cases, doubling_time_5d, doubling_time_10d, population, county, region_no) %>% arrange(desc(cases)) %>% mutate_at(vars(matches("doubling")), ~as.character(.x) %>% coalesce("")) %>% mutate(cases_per_pop = coalesce(cases_per_pop, 0), cases_summary = ifelse(str_detect(region_no, "^[0-9]{4}$"), cases, 0) %>% coalesce(0), cases_new_summary = ifelse(str_detect(region_no, "^[0-9]{4}$"), cases_inc_1d, 0) %>% coalesce(0)) inf_sd <- SharedData$new(inf_tbl) ``` Dashboard {data-icon="fa-dashboard"} ===================================== Inputs {.sidebar} -------------------------------------

Updated: `r max(inf_raw$date_time+3600*2, na.rm = TRUE) %>% format("%d. %B %y %H:%M")`

```{r} filter_select("county_select", "County", inf_sd, ~county, multiple = FALSE) ``` ```{r} filter_slider("pop_slider", "Population", inf_sd, ~population, min = 0, max = 750E3) ``` ```{r} filter_slider("case_slider", "Cases", inf_sd, ~cases) ```

`r summarywidget(inf_sd, "sum", "cases_summary")`

Total Cases

`r summarywidget(inf_sd, "sum", "cases_new_summary")`

New cases last 24h

Column ------------------------------------- ### Key figures ```{r} #################################### # # Table ---- #################################### # variables <- c("region", "cases", "cases_inc_1d", "cases_per_pop", "sparkline_cases", "sparkline_new_cases", "doubling_time_5d", "doubling_time_10d") escape <- c("sparkline_cases", "sparkline_new_cases") sortblank <- c("doubling_time_5d", "doubling_time_10d") sortdesc <- c("cases", "cases_inc_1d", "cases_per_pop") non_align <- c("region", "sparkline_cases", "sparkline_new_cases") cols_vis <- which(names(inf_tbl) %in% variables)-1 cols_invis <- which(!names(inf_tbl) %in% variables)-1 cols_escape <- which(names(inf_tbl) %in% escape)-1 cols_sort <- which(names(inf_tbl) %in% sortblank)-1 cols_sortdesc <- which(names(inf_tbl) %in% sortdesc)-1 cols_align <- which(!names(inf_tbl) %in% non_align)-1 # JS hack to properly allow sorting of doubling_x_days-columns callback_sort <- JS(paste0(" $.fn.dataTableExt.oSort['NumericOrBlank-asc'] = function(x,y) { var retVal; if( x === '' || $.isEmptyObject(x)) x = 1000; if( y === '' || $.isEmptyObject(y)) y = 1000; x = (x = parseFloat($.trim(x).replace(/,/g,''))) ? x : 0; y = (y = parseFloat($.trim(y).replace(/,/g,''))) ? y : 0; if (x==y) retVal= 0; else retVal = (x>y) ? 1 : -1; return retVal; }; $.fn.dataTableExt.oSort['NumericOrBlank-desc'] = function(y,x) { var retVal; x = (x = parseFloat($.trim(x).replace(/,/g,''))) ? x : 0; y = (y = parseFloat($.trim(y).replace(/,/g,''))) ? y : 0; if (x==y) retVal= 0; else retVal = (x>y) ? 1 : -1; return retVal; }")) sketch <- htmltools::withTags(table( class = 'display', thead( tr( th('', style = "border: 0;"), th(colspan = 3, 'Cases'), th(colspan = 2, 'Trend'), th(colspan = 2, 'Doubling rate') ), tr( lapply(c("Region", "Total", "New 24h", "Per 1000", "Trend", "Growth", "5 days", "10 days"), th) ) ) )) inf_sd %>% datatable( escape = cols_escape, container = sketch, rownames = FALSE, #filter = "top", callback = callback_sort, plugins = "natural", colnames = c("Region" = "region", "Total" = "cases", "Per 1.000" = "cases_per_pop", "New 24h" = "cases_inc_1d", "Trend" = "sparkline_cases", "Growth" = "sparkline_new_cases", "5 days" = "doubling_time_5d", "10 days" = "doubling_time_10d"), options = list( extensions = c("Scroller"), dom = "lrt", paging = FALSE, autowidth = TRUE, scroller = TRUE, scrollY = 500, #scroller = TRUE, columnDefs = list( list(className = 'dt-left', targets = 0), list(orderSequence = c('desc', 'asc'), targets = cols_sortdesc), list(visible = FALSE, targets = cols_invis), list(orderable = FALSE, className = 'dt-center', targets = cols_escape), list(className = 'dt-right', targets = cols_align), list(type = "NumericOrBlank", targets = cols_sort) ))) %>% formatStyle(columns = "5 days", valueColumns = "5 days", background = styleColorBar(seq(0, 40, 1), 'orange', angle = 90), backgroundSize = '95% 70%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center') %>% formatStyle(columns = "10 days", valueColumns = "10 days", background = styleColorBar(seq(0, 40, 1), 'orange', angle = 90), backgroundSize = '95% 70%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center') %>% formatStyle(columns = "Per 1.000", valueColumns = "Per 1.000", background = styleColorBar(seq(0, 12, 1), 'orange', angle = 90), backgroundSize = '95% 70%', backgroundRepeat = 'no-repeat', backgroundPosition = 'center') %>% sparkline::spk_add_deps() ``` Column ------------------------------------- ### Cases per municipality and district ```{r} #################################### # # Map ---- #################################### # leaf_col <- c("#ecda9a", "#efc47e", "#f3ad6a", "#f7945d", "#f97b57", "#f66356", "#ee4d5a") pal_log <- colorNumeric(leaf_col, inf_map$cases_log, na.color = "transparent") pal_fac <- colorFactor(leaf_col, levels = levels(inf_map$cases_per_pop_grp), na.color = "transparent") lab_log <- labelFormat(transform = function(x) 10^x) js_hack <- paste(" function(el, x) { var updateLegend = function () { var selectedGroup = document.querySelectorAll('input:checked')[0].nextSibling.innerText.substr(1); document.querySelectorAll('.legend').forEach(a => a.hidden=true); document.querySelectorAll('.legend').forEach(l => { if (l.children[0].children[0].innerText == selectedGroup) l.hidden=false; }); }; updateLegend(); this.on('baselayerchange', e => updateLegend()); }") inf_map %>% rename(`Total Cases` = cases_log, `Per 1.000` = cases_per_pop_grp) %>% leaflet() %>% addProviderTiles(providers$CartoDB) %>% addPolygons(fillColor = ~pal_fac(`Per 1.000`), group = "Per 1.000", fillOpacity = 0.7, weight = 1, label = ~region, popup = ~popup_table, color = "grey") %>% addPolygons(fillColor = ~pal_log(`Total Cases`), fillOpacity = 0.7, group = "Total Cases", label = ~region, popup = ~popup_table, weight = 1, color = "grey") %>% addLegend(position= "topright", pal = pal_fac, values = ~`Per 1.000`, group = "Per 1.000") %>% addLegend(position= "topright", pal = pal_log, bins = c(0, 1, 2, 3, 4), labFormat = lab_log, values = ~`Total Cases`, group = "Total Cases") %>% addLayersControl(baseGroups = c("Per 1.000", "Total Cases"), position = "topleft", options = layersControlOptions(collapsed=F)) %>% #setView(17.6, 65.9, zoom = 4.5) %>% htmlwidgets::onRender(js_hack) ```